Visual Basic Controls/Visual Basic Controls.iso/vbcontrol/mwheel/MWTEST4.FRM

Visual Basic Form | 1997-08-15 | 5.2 KB | 159 lines

VERSION 4.00
Begin VB.Form Form1
   Caption         =   "MouseWheel ActiveX Demonstration"
   ClientHeight    =   7800
   ClientLeft      =   3330
   ClientTop       =   2010
   ClientWidth     =   5595
   Height          =   8205
   Icon            =   "MWTest4.frx":0000
   Left            =   3270
   LinkTopic       =   "Form1"
   ScaleHeight     =   7800
   ScaleWidth      =   5595
   Top             =   1665
   Width           =   5715
   Begin VB.CheckBox Check1
      Caption         =   "Turn on Notifications"
      Height          =   195
      Left            =   180
      TabIndex        =   0
      Top             =   240
      Width           =   2355
   End
   Begin VB.OptionButton Option1
      Caption         =   "ControlUnderMouse"
      Height          =   195
      Index           =   1
      Left            =   2400
      TabIndex        =   2
      Top             =   600
      Width           =   1875
   End
   Begin VB.OptionButton Option1
      Caption         =   "ControlWithFocus"
      Height          =   195
      Index           =   0
      Left            =   180
      TabIndex        =   1
      Top             =   600
      Width           =   1875
   End
   Begin VB.VScrollBar VScroll1
      Height          =   6795
      LargeChange     =   50
      Left            =   5220
      Max             =   500
      TabIndex        =   5
      Top             =   900
      Width           =   255
   End
   Begin VB.HScrollBar HScroll1
      Height          =   255
      LargeChange     =   50
      Left            =   180
      Max             =   500
      TabIndex        =   6
      Top             =   7440
      Width           =   4935
   End
   Begin VB.ListBox List1
      Height          =   3135
      IntegralHeight  =   0   'False
      Left            =   180
      TabIndex        =   4
      Top             =   4200
      Width           =   4935
   End
   Begin VB.TextBox Text1
      Height          =   3135
      Left            =   180
      MultiLine       =   -1  'True
      ScrollBars      =   3  'Both
      TabIndex        =   3
      Text            =   "MWTest4.frx":000C
      Top             =   900
      Width           =   4935
   End
   Begin MouseWheelOCX.MouseWheel MouseWheel1
      Left            =   4620
      Top             =   180
      _ExtentX        =   847
      _ExtentY        =   847
   End
Attribute VB_Name = "Form1"
Attribute VB_Creatable = False
Attribute VB_Exposed = False
Option Explicit
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Long) As Long
Private Sub MouseWheel1_AfterMouseWheel(ByVal hWnd As Long, ByVal Delta As Long, ByVal Shift As Long, ByVal Button As Long, ByVal x As Long, ByVal y As Long)
   Select Case hWnd
      Case Me.hWnd, Option1(0).hWnd, Option1(1).hWnd
         If Option1(0).Value Then
            Option1(1).Value = True
         Else
            Option1(0).Value = True
         End If
      Case Check1.hWnd
         Check1.Value = Abs(Not CBool(Check1.Value))
   End Select
End Sub
Private Sub MouseWheel1_BeforeMouseWheel(ByVal hWnd As Long, ByVal Delta As Long, ByVal Shift As Long, ByVal Button As Long, ByVal x As Long, ByVal y As Long, Cancel As Boolean)
   'Debug.Print "MouseWheel hWnd: "; Hex(hWnd), "Delta:"; Delta, _
               "Shift: "; Hex(Shift), "Button: "; Hex(Button), _
               "X,Y: "; CStr(x); ","; CStr(y)
   Call UpdateCaption
   Select Case hWnd
      Case Text1.hWnd
         If Button = vbMiddleButton Then
            Call MouseWheel1.HorzScroll(hWnd, Delta)
            Cancel = True
         End If
   End Select
End Sub
Private Sub UpdateCaption()
   ' Query for current number of scrolllines
   MouseWheel1.Refresh
   If MouseWheel1.ScrollLines = -1 Then
      Me.Caption = "ScrollLines: WHEEL_PAGESCROLL"
   Else
      Me.Caption = "ScrollLines: " & MouseWheel1.ScrollLines
   End If
End Sub
Private Sub Check1_Click()
   ' Turn on notification for these windows.
   ' Only required in WinNT.
   MouseWheel1.hWndNotify(Text1.hWnd) = CBool(Check1.Value)
   MouseWheel1.hWndNotify(List1.hWnd) = CBool(Check1.Value)
End Sub
Private Sub Form_Load()
   Dim i As Long, p As String
   Dim f As String
   ' Show form so it looks like something's happening
   Me.Move (Screen.Width - Me.ScaleWidth) / 2, (Screen.Height - Me.ScaleHeight) / 2
   Me.Show
   Me.Refresh
   Me.MousePointer = vbHourglass
   ' Fill text boxes with "stuff"
   Open Environ("windir") & "\win.ini" For Binary As #1
   Text1.Text = Input(LOF(1), 1)
   Close #1
   Text1.Refresh
   ' Fill listbox with "stuff"
   f = Dir(Environ("windir") & "\*.*")
   Do While Len(f)
      List1.AddItem f
      f = Dir
   Loop
   List1.Refresh
   ' Turn on mouse wheel notification, and caption
   Call UpdateCaption
   Check1.Value = vbChecked
   Option1(0).Value = True
   Me.MousePointer = vbDefault
End Sub
Private Sub Option1_Click(Index As Integer)
   ' Toggle ScrollWhich property
   MouseWheel1.ScrollWhich = Index
End Sub